home *** CD-ROM | disk | FTP | other *** search
/ APDL Eductation Resources / APDL Eductation Resources.iso / programs / graphics / turtle_2 / !TURTLE / Turtle < prev   
Encoding:
Text File  |  1991-11-22  |  17.2 KB  |  547 lines
  1. 10 REM>!Turtle
  2. 20 REM Version 2.1
  3. 30 REM 7.3.1991
  4. 40 REM Modified version of A&B Computing (date ?) LINE 100
  5. 50 REM by J.T.Sutton, M.Charlton & C.Williams
  6. 55 
  7. 60 MODE 15
  8. 70 OSCLI ("SCREENLOAD "+"<turtle$dir>.pic")
  9. 72 BG$=INKEY$(300):BG=128
  10. 90 MODE 12
  11. 100 VDU 23,123,0,0,31,63,127,255,96,192
  12. 110 VDU 23,125,0,28,156,240,240,224,192,96
  13. 230 CLOSE#0
  14. 240 PROCinit
  15. 250 *FX21,0
  16. 260 ON ERROR GOTO 5460
  17. 270 PROCmode
  18. 275 PRINT"Do you wish to load a file of procedures?"
  19. 276 REPEAT:g$=GET$:UNTIL INSTR("YyNn",g$)<>0
  20. 280 IF g$="Y" OR g$="y" THEN PROCload
  21. 310 CLS
  22. 320 C$=FNinput:IF C$="" THEN 320
  23. 330 PROCchoose
  24. 340 GOTO 320
  25. 350 
  26. 360 DEFPROCsysex:LOCALx%,y%
  27. 370 ON C% GOSUB 392,410,440,480,510,540,570,650,1190,1440,650,710,750,780,840,810,890,970,940,1010,1040,1070,1510,1100,1130,1160,1250,1220,1280,1310,1540,1370,1340,600,1470,680
  28. 380 ENDPROC
  29. 390
  30. 391 REM OSCLI
  31. 392 OSCLI(P$)
  32. 393 RETURN
  33. 396  
  34. 400 REM CLEAR
  35. 410 S%=0:CLG:GOTO 450
  36. 420 
  37. 430 REM HOME CURSOR
  38. 440 PROCcursor
  39. 450 K%=K% AND 175:BE=0:X=0:Y=0:MOVE X,Y:PROCcursor:RETURN
  40. 460 
  41. 470 REM PEN UP
  42. 480 IF K% AND 2 THEN RETURN ELSE K%=K% AND 174:RETURN
  43. 490 
  44. 500 REM PEN DOWN
  45. 510 K%=K% OR 1:RETURN
  46. 520 
  47. 530 REM END FILL
  48. 540 K%=K% AND 175:RETURN
  49. 550 
  50. 560 REM FILL
  51. 570 IF K% AND 80 THEN RETURN ELSE K%=K% OR 81:FOR I=0 TO 7:fx(I)=X:fy(I)=Y:NEXT:RETURN
  52. 580 
  53. 590 REM DISPLAY
  54. 600 PROCcursor:F%=F% EOR 16:PROCcursor:x%=POS:y%=VPOS:VDU 28,0,31,SW%,0,30
  55. 610 IF F% AND 64 THEN VDU 28,0,31,SW%,28: ELSE VDU 28,0,31,SW%,26
  56. 620 VDU 31,x%,y%:RETURN
  57. 630 
  58. 640 REM CIRCLE
  59. 650 PROCcursor:GCOL0,CO:PROCcircle(P):MOVE X,Y:PROCcursor:RETURN
  60. 660 
  61. 670 REM QUIT
  62. 680 S%=0:PROCquit:RETURN
  63. 690 
  64. 700 REM COLOUR
  65. 710 CO=P:IF L%>0 THEN RETURN ELSE IF CO<0 OR CO>15 THEN 720 ELSE RETURN
  66. 720 PROCmsg(22,""):PROCmsg(23,""):CO=V%:RETURN
  67. 730 
  68. 740 REM CURSOR RIGHT
  69. 750 K%=K% AND 175:PROCcursor:X=X+P*XL%:MOVE X,Y:PROCcursor:RETURN
  70. 760 
  71. 770 REM CURSOR UP
  72. 780 K%=K% AND 175:PROCcursor:Y=Y+P*XL%:MOVE X,Y:PROCcursor:RETURN
  73. 790 
  74. 800 REM LEFT
  75. 810 P=-P
  76. 820 
  77. 830 REM RIGHT
  78. 840 PROCcursor:BE=BE+P:IF BE<0 THEN BE=360+(BE MOD 360)
  79. 850 IF BE>360 THEN BE=BE MOD 360
  80. 860 PROCcursor:RETURN
  81. 870 
  82. 880 REM BEARING
  83. 890 PROCcursor:BE=P:IF BE>360 THEN BE=BE MOD 360
  84. 900 IF BE<0 THEN BE=360+(BE MOD 360)
  85. 910 PROCcursor:RETURN
  86. 920 
  87. 930 REM BACKWARDS
  88. 940 P=-P
  89. 950 
  90. 960 REM FORWARDS
  91. 970 PROCcursor:X=X+FNx(P,BE):Y=Y+FNy(P,BE)
  92. 980 PROCplot:RETURN
  93. 990 
  94. 1000 REM NUMBER
  95. 1010 NM=P:NUMBER=P:RETURN
  96. 1020 
  97. 1030 REM TURN
  98. 1040 TR=P:TURN=P:RETURN
  99. 1050 
  100. 1060 REM SIZE
  101. 1070 SZ=P:SIZE=P:RETURN
  102. 1080 
  103. 1090 REM REPEAT
  104. 1100 PROCrepeat:RETURN
  105. 1110 
  106. 1120 REM DEFINE
  107. 1130 PROCdefine:RETURN
  108. 1140 
  109. 1150 REM EDIT
  110. 1160 S%=0:PROCedit:RETURN
  111. 1170 
  112. 1180 REM END REPEAT
  113. 1190 IF L%=0 THEN F%=F% AND 253:S%=0:RETURN ELSE RETURN
  114. 1200 
  115. 1210 REM DESCRIBE
  116. 1220 PROCdescribe:RETURN
  117. 1230 
  118. 1240 REM DELETE
  119. 1250 PROCdelete:RETURN
  120. 1260 
  121. 1270 REM HELP
  122. 1280 CLS:FOR J%=1 TO 36:PRINT MID$(COM$,J%*2-1,2);" - ";COM$(J%):G%=GET:NEXT:RETURN
  123. 1290 
  124. 1300 REM LIST
  125. 1310 CLS:FOR J%=1 TO D%:PRINT D$(J%,0);"  ";:NEXT:RETURN
  126. 1320 
  127. 1330 REM PALETTE
  128. 1340 PROCcolour:RETURN
  129. 1350 
  130. 1360 REM VALUES
  131. 1370 CLS:PRINT"NUMBER  (NM) = ";NM
  132. 1380 PRINT"SIZE    (SZ) = ";SZ
  133. 1390 PRINT"TURN    (TR) = ";TR
  134. 1400 PRINT
  135. 1410 PRINT"COLOUR  (CO) = ";CO;:RETURN
  136. 1420 
  137. 1430 REM END DEFINE
  138. 1440 IF L%=0 THEN S%=0:RETURN ELSE RETURN
  139. 1450 
  140. 1460 REM PRINT
  141. 1470 PROCdump
  142. 1480 RETURN
  143. 1490 
  144. 1500 REM WRITE
  145. 1510 PROCcursor:VDU 5:GCOL3,CO:PRINT P$:VDU 4:MOVE X,Y:PROCcursor:RETURN
  146. 1520 
  147. 1530 REM LOAD
  148. 1540 PROCload:RETURN
  149. 1550 
  150. 1560 DEFPROCdefex(C%)
  151. 1570 C%=C% AND 127:L%=L%+1
  152. 1580 W%?L%=C%:E%?L%=1
  153. 1590 PROCextract
  154. 1600 IF C%=24 THEN R%?L%=E%?L%:N%?L%=ABS(INT(P)):GOTO 1630
  155. 1610 IF C%=9 AND N%?L%>1 THEN E%?L%=R%?L%:N%?L%=N%?L%-1:GOTO 1630
  156. 1620 PROCchoose
  157. 1630 IF C%<>10 THEN 1590
  158. 1640 L%=L%-1
  159. 1650 ENDPROC
  160. 1660 
  161. 1670 DEFPROCchoose
  162. 1680 IF C% AND 128 THEN PROCdefex(C%) ELSE PROCsysex
  163. 1690 ENDPROC
  164. 1700 
  165. 1730 DEFPROCextract
  166. 1740 P%=INSTR(MID$(D$(W%?L%,1),E%?L%),CHR$10)
  167. 1750 T$=MID$(D$(W%?L%,1),E%?L%,P%):E%?L%=E%?L%+P%
  168. 1760 C%=ASC(T$):IF LEN(T$)>2 AND (C%<>23 AND C%<>1) THEN P=EVAL(MID$(T$,2)) ELSE P=0
  169. 1770 IF C%=23 OR C%=1 THEN P$=MID$(T$,2,LEN(T$)-2)
  170. 1780 ENDPROC
  171. 1790 
  172. 1800 DEFPROCundo
  173. 1810 IF S%=0 THEN PROCmsg(14,""):PROCmsg(18,""):GOTO 1880
  174. 1820 IF F% AND 2 THEN PROCdel(0):GOTO 1840
  175. 1830 IF F% AND 1 THEN PROCdel(D%)
  176. 1840 PROCreset
  177. 1850 IF C%=23 THEN PROCchoose:GOTO 1870
  178. 1860 IF C%=11 OR C%=18 OR C%=19 OR C%>128 THEN PROCreplot:K%=K% OR 2:PROCchoose:K%=K% AND 253:PROCreset:PROCreplot
  179. 1870 S%=S%-1:T%=T%-1-5*(T%=0)
  180. 1880 ENDPROC
  181. 1890 
  182. 1900 DEFPROCrecord
  183. 1910 S%=S%+1+(S%=5):T%=T%+1+5*(T%=4)
  184. 1920 C%(T%)=C%:BE(T%)=BE:X(T%)=X:Y(T%)=Y:TR(T%)=TR:NM(T%)=NM:SZ(T%)=SZ:P(T%)=P:F%(T%)=F%:K%(T%)=K%:CO(T%)=CO:P$(T%)=P$
  185. 1930 ENDPROC
  186. 1940 
  187. 1950 DEFPROCreset
  188. 1960 PROCcursor
  189. 1970 C%=C%(T%):BE=BE(T%):X=X(T%):Y=Y(T%):TR=TR(T%):TURN=TR(T%):NM=NM(T%):NUMBER=NM(T%):SZ=SZ(T%):SIZE=SZ(T%):P=P(T%):F%=F%(T%):K%=K%(T%):CO=CO(T%):P$=P$(T%)
  190. 1980 MOVE X,Y:PROCcursor
  191. 1990 ENDPROC
  192. 2000 
  193. 2010 DEFPROCdel(DL%)
  194. 2020 REPEAT:D$(DL%,1)=LEFT$(D$(DL%,1),LEN(D$(DL%,1))-1):UNTIL RIGHT$(D$(DL%,1),1)=CHR$(10) OR LEN(D$(DL%,1))=0
  195. 2030 ENDPROC
  196. 2040 
  197. 2050 DEFPROCreplot
  198. 2060 Q%=Q%-1-7*(Q%=0)
  199. 2070 ENDPROC
  200. 2080 
  201. 2090 DEFPROCplot
  202. 2100 GCOL 0,CO
  203. 2110 IF K% AND 80 THEN 2140
  204. 2120 PLOT K%,X,Y
  205. 2130 PROCcursor:GOTO 2160
  206. 2140 IF fy(Q%)<(Y+1) AND fy(Q%)>(Y-1) AND fy(Q%-1-7*(Q%=0))<(Y+1) AND fy(Q%-1-7*(Q%=0))>(Y-1) THEN PLOT K% AND 175,X,Y:Q%=Q%+1+7*(Q%=6):fx(Q%)=X:fy(Q%)=Y:GOTO 2130
  207. 2150 MOVE fx(Q%),fy(Q%):MOVE fx(Q%-1-7*(Q%=0)),fy(Q%-1-7*(Q%=0)):Q%=Q%+1+7*(Q%=6):fx(Q%)=X:fy(Q%)=Y:GOTO 2120
  208. 2160 ENDPROC
  209. 2170 
  210. 2180 DEFFNx(D,BE)
  211. 2190 =(COS(RAD(BE-90)))*D*XL%
  212. 2200 
  213. 2210 DEFFNy(D,BE)
  214. 2220 =-(SIN(RAD(BE-90)))*D*XL%
  215. 2230 
  216. 2240 DEFPROCcircle(r)
  217. 2250 LOCALx,y,xx,yy
  218. 2260 VDU 29,642+X;610+Y;
  219. 2270 FOR I%=0 TO 4
  220. 2280 xx=C(I%)*r*XL%
  221. 2290 yy=S(I%)*r*XL%
  222. 2300 x=C(I%+1)*r*XL%
  223. 2310 y=S(I%+1)*r*XL%
  224. 2320 MOVE 0,0:MOVE xx,yy:PLOT K%,x,y
  225. 2330 MOVE 0,0:MOVE xx,-yy:PLOT K%,x,-y
  226. 2340 MOVE 0,0:MOVE -xx,yy:PLOT K%,-x,y
  227. 2350 MOVE 0,0:MOVE -xx,-yy:PLOT K%,-x,-y
  228. 2360 MOVE 0,0:MOVE yy,xx:PLOT K%,y,x
  229. 2370 MOVE 0,0:MOVE yy,-xx:PLOT K%,y,-x
  230. 2380 MOVE 0,0:MOVE -yy,xx:PLOT K%,-y,x
  231. 2390 MOVE 0,0:MOVE -yy,-xx:PLOT K%,-y,-x
  232. 2400 NEXT:VDU 29,642;610;
  233. 2410 ENDPROC
  234. 2420 
  235. 2430 DEFPROCcursor
  236. 2440 IF F% AND 16 THEN GCOL3,2: ELSE GOTO 2500
  237. 2450 PLOT 1,FNx(6,BE),FNy(6,BE)
  238. 2460 PLOT 0,FNx(6,BE),FNy(6,BE)
  239. 2470 PLOT 0,FNx(6,BE+150),FNy(6,BE+150)
  240. 2480 PLOT 81,FNx(6,BE+270),FNy(6,BE+270)
  241. 2490 MOVE X,Y
  242. 2500 ENDPROC
  243. 2510 
  244. 2520 DEFPROCrepeat
  245. 2530 F%=F% OR 2:IF F% AND 64 THEN 2690 ELSE ?N%=ABS(INT(P)):D$(0,1)=""
  246. 2540 REPEAT
  247. 2550 C$=FNinput
  248. 2560 IF C%=24 THEN 2700
  249. 2570 IF C$="" THEN 2550
  250. 2580 IF C%>27 AND C%<35 THEN 2600
  251. 2590 D$(0,1)=D$(0,1)+C$
  252. 2600 PROCchoose
  253. 2610 UNTIL C%=9
  254. 2620 IF F% AND 1 THEN D$(D%,1)=D$(D%,1)+D$(0,1)
  255. 2630 FOR J%=2 TO ?N%:E%?L%=1:W%?L%=0
  256. 2640 REPEAT
  257. 2650 PROCextract
  258. 2660 PROCchoose
  259. 2670 UNTIL C%=9
  260. 2680 NEXT
  261. 2690 GOTO 2710
  262. 2700 UNTILC$=""
  263. 2710 ENDPROC
  264. 2720 
  265. 2730 DEFPROCdefine
  266. 2740 F%=F% OR 1:D%=D%+1
  267. 2750 D$(0,0)=P$:D$(D%,1)=""
  268. 2760 REPEAT
  269. 2770 C$=FNinput
  270. 2780 IF C%=25 THEN 2870
  271. 2790 IF C$="" THEN 2770
  272. 2800 IF C%>28 AND C%<35 THEN 2820
  273. 2810 D$(D%,1)=D$(D%,1)+C$
  274. 2820 PROCchoose
  275. 2830 UNTIL C%=10
  276. 2840 D$(D%,0)=D$(0,0)
  277. 2850 F%=F% AND 254
  278. 2860 GOTO 2890
  279. 2870 UNTILC$=""
  280. 2880 D%=D%-1
  281. 2890 ENDPROC
  282. 2900 
  283. 2910 DEFPROCedit
  284. 2920 GOSUB 410:CLS:PRINT"E nter","D elete","I nsert","R eplace"
  285. 2930 F%=F% OR 65
  286. 2940 VDU 28,0,31,SW%,28
  287. 2950 D$(0,1)="":?W%=P AND 127:?E%=1
  288. 2960 REPEAT
  289. 2970 PROCextract
  290. 2980 IF C% AND 128 THEN PRINTD$(C% AND 127,0); ELSE PRINT COM$(C%);
  291. 2990 PRINT" ";MID$(T$,2);CHR$13;
  292. 3000 A$=GET$:IF C%=10 AND (F% AND 2)=2 THEN ON INSTR("EI",A$)+1 GOTO 3000,3030,3050
  293. 3010 IF C%=10 THEN ON INSTR("EI",A$)+1 GOTO 3000,3040,3050
  294. 3020 ON INSTR("EDIR",A$)+1 GOTO 3000,3040,3080,3050,3050
  295. 3030 PROCmsg(132,"still"):PRINT:GOTO 2980
  296. 3040 D$(0,1)=D$(0,1)+T$:GOTO 3060
  297. 3050 D$(0,1)=D$(0,1)+FNinput:PRINT:IF A$="I" THEN ?E%=?E%-P%
  298. 3060 PROCchoose:IF C%=24 THEN ?R%=LEN(D$(0,1))+1:?N%=ABS(INT(P))
  299. 3070 IF C%=9 THEN Z%?0=?W%:Z%?1=?E%:?W%=0:FOR J%=2 TO ?N%:?E%=?R%:REPEAT:PROCextract:PROCchoose:UNTIL C%=9:NEXT:?W%=Z%?0:?E%=Z%?1
  300. 3080 UNTIL C%=10
  301. 3090 D$(?W%,1)=D$(0,1)
  302. 3100 VDU 28,0,31,SW%,26,12:F%=F% AND 190
  303. 3110 ENDPROC
  304. 3120 
  305. 3130 DEFPROCdescribe
  306. 3140 CLS
  307. 3150 ?W%=P AND 127:?E%=1
  308. 3160 REPEAT
  309. 3170 PROCextract
  310. 3180 IF C% AND 128 THEN PRINTD$(C% AND 127,0); ELSE PRINT COM$(C%);
  311. 3190 PRINT" ";MID$(T$,2);CHR$13;
  312. 3200 G%=GET
  313. 3210 UNTIL C%=10
  314. 3220 ENDPROC
  315. 3230 
  316. 3240 DEFPROCdelete
  317. 3250 FOR J%=1 TO D%:IF INSTR(D$(J%,1),CHR$P+CHR$10) THEN PROCmsg(13,""):PROCmsg(81,D$(J%,0)):J%=D%+10
  318. 3260 NEXT
  319. 3270 IF J%>D%+10 THEN 3330
  320. 3280 P=P AND 127:IF P=D% THEN D$(D%,0)="":D$(D%,1)="":GOTO 3320
  321. 3290 FOR J%=P TO D%-1:D$(J%,0)=D$(J%+1,0):D$(J%,1)=D$(J%+1,1):NEXT
  322. 3300 P=P OR 128:FOR J%=1 TO D%:PROCchange(J%,P,-1)
  323. 3310 NEXT
  324. 3320 D%=D%-1
  325. 3330 ENDPROC
  326. 3340 
  327. 3350 DEFPROCchange(j%,t%,d%)
  328. 3360 LOCALl%
  329. 3370 FOR l%=1 TO LEN(D$(j%,1))
  330. 3380 IF ASC(MID$(D$(j%,1),l%,1))>t% THEN D$(j%,1)=LEFT$(D$(j%,1),l%-1)+CHR$(ASC(MID$(D$(j%,1),l%,1))+d%)+MID$(D$(j%,1),l%+1)
  331. 3390 NEXT
  332. 3400 ENDPROC
  333. 3410 
  334. 3420 DEFPROCcolour
  335. 3440 CLS:PRINT"This is your colour palette, the background is black."
  336. 3470 PRINT"0-black 1-red 2-green 3-yellow 4-blue 5-magenta 6-cyan 7-white 8-light grey     9-mid grey 10-dark grey 11-orange 12-cream 13-dark green 14-purple 15-brown."
  337. 3480 PRINT"Enter the number of new colour required after the CO command."
  338. 3560 ENDPROC
  339. 3570 
  340. 3580 DEFPROCquit
  341. 3590 LOCALq%,a$
  342. 3600 CLS:PRINT"Do you wish to save your procedures?"'
  343. 3602 REPEAT:g$=GET$:UNTIL INSTR("YyNn",g$)<>0
  344. 3610 IF g$="N" OR g$="n" THEN 3810
  345. 3620 INPUT"Enter file name "''a$:IF a$ = "" OR LEN(a$)>10 THEN GOTO 3620
  346. 3630 q%=OPENOUT(a$)
  347. 3640 FOR J%=1 TO D%:BPUT#q%,D$(J%,0)
  348. 3650 p%=1
  349. 3660 WHILE p%<=LEN(D$(J%,1))
  350. 3670 IF ASC(MID$(D$(J%,1),p%,1))>128 THEN BPUT#q%,D$(ASC(MID$(D$(J%,1),p%,1))-128,0):p%+=1:GOTO 3760
  351. 3680 IF ASC(MID$(D$(J%,1),p%,1))=10 THEN p%+=1:GOTO 3760
  352. 3690 IF ASC(MID$(D$(J%,1),p%,1))<11 THEN
  353. 3700 BPUT#q%,COM$(ASC(MID$(D$(J%,1),p%,1))):p%+=1
  354. 3710 ELSE
  355. 3720 PP$=COM$(ASC(MID$(D$(J%,1),p%,1))):p%+=1
  356. 3730 P$="":REPEAT:P$+=MID$(D$(J%,1),p%,1):p%+=1:UNTIL ASC(MID$(D$(J%,1),p%,1))<25
  357. 3740 PP$=PP$+" "+P$:BPUT#q%,PP$
  358. 3750 ENDIF
  359. 3760 ENDWHILE
  360. 3770 BPUT#q%,"END":BPUT#q%,""
  361. 3780 NEXT
  362. 3790 CLOSE#q%
  363. 3800 OSCLI("SETTYPE "+a$+" BAD")
  364. 3810 VDU 22,7,12
  365. 3811 OSCLI("DIR $")
  366. 3820 END
  367. 3830 
  368. 3840 
  369. 3850 DEFFNinput
  370. 3860 IF F% AND 2 THEN PT$=RP$ ELSE IF F% AND 1 THEN PT$=DF$ ELSE PT$=CM$
  371. 3870 PRINT'PT$;:C$="":P$=""
  372. 3880 G%=GET
  373. 3890 IF (G%>96 AND G%<123) THEN G%-=32
  374. 3900 IF (G%>39 AND G%<58 AND G%<>44) OR (G%>64 AND G%<91) OR (G%>127 AND G%<138) THEN 3970
  375. 3910 IF G%=127 AND LEN(C$)>0 THEN C$=LEFT$(C$,LEN(C$)-1):PRINTCHR$G%;:GOTO 3880
  376. 3920 IF G%=13 AND (C$="F" OR C$="B" OR C$="R" OR C$="L") THEN 3980
  377. 3930 IF LEN(C$)>1 AND G%=13 THEN 3980
  378. 3940 IF G%=32 AND (LEN(C$)=3 OR (LEN(C$)=4 AND ASC(C$)=72) OR (LEN(C$)=5 AND ASC(C$)=67) OR (LEN(C$)=6 AND C$="CURSOR")) THEN 3970
  379. 3950 IF G%=32 THEN 3980
  380. 3960 VDU 7:GOTO 3880
  381. 3970 PRINTCHR$G%;:C$=C$+CHR$G%:GOTO 3880
  382. 3980 C%=FNfind(C$):IF C%=0 THEN PROCmsg(65,C$):GOTO 3860
  383. 3990 IF FNcheck THEN 3860
  384. 3991 IF C%=1 THEN 4060
  385. 4000 IF C%=8 AND (F% AND 64) THEN PROCmsg(20,""):PROCmsg(24,""):=""
  386. 4010 IF C%=8 THEN PROCundo:=""
  387. 4020 IF C%<11 OR C%>128 THEN PROCrecord
  388. 4030 IF C%<11 OR C%>28 THEN P=0:C$=CHR$(C%):=C$+CHR$10
  389. 4040 IF G%=32 THEN 4060
  390. 4050 IF C%<25 AND C%<>23 THEN PROCmsg(2,""):PRINT'C$;:ELSE PROCmsg(3,""):PRINT'C$;
  391. 4060 PRINT" ";
  392. 4070 P$=""
  393. 4080 G%=GET
  394. 4090 IF (G%>96 AND G%<123) THEN G%-=32
  395. 4095 IF C%=1 AND INSTR(" |$<>",CHR$(G%)) THEN PRINTCHR$G%;:P$=P$+CHR$G%:GOTO 4080
  396. 4100 IF (G%>39 AND G%<58 AND G%<>44) OR (G%>64 AND G%<91) OR (G%>127 AND G%<138) THEN PRINTCHR$G%;:P$=P$+CHR$G%:GOTO 4080
  397. 4110 IF G%=127 AND LEN(P$)>0 THEN P$=LEFT$(P$,LEN(P$)-1):PRINTCHR$G%;:GOTO 4080
  398. 4120 IF G%<>13 THEN VDU 7:GOTO 4080
  399. 4125 IF C%=1 THEN 4150
  400. 4130 G%=FNfind(P$):IF FNvalid THEN 3860
  401. 4140 IF C%<25 AND C%<>23 THEN P=EVAL(P$) ELSE IF C%>25 AND C%<29 THEN P=G% ELSE P=0
  402. 4150 IF C%<26 THEN PROCrecord
  403. 4160 C$=CHR$(C%)
  404. 4170 =C$+P$+CHR$10
  405. 4180 
  406. 4190 DEFFNfind(F$)
  407. 4200 LOCALc%
  408. 4210 c%=INSTR(COM$,F$):IF c%/2<>INT(c%/2) THEN =((c%+1)/2) ELSE c%=0
  409. 4220 REPEAT:c%=c%+1:UNTIL F$=COM$(c%) OR c%=37:IF c%<37 THEN =c%
  410. 4230 c%=0:REPEAT:c%=c%+1:UNTIL F$=D$(c%,0) OR D$(c%,0)=""
  411. 4240 IF D$(c%,0)="" THEN =0 ELSE =c% OR 128
  412. 4250 
  413. 4260 DEFFNcheck
  414. 4270 IF (F% AND 2) AND ((C%>24 AND C%<29) OR C%=10 OR C%=35 OR C%=36) THEN PROCmsg(4,""):PROCmsg(80,C$):=TRUE
  415. 4280 IF (F% AND 64) AND C%>25 AND C%<37 THEN PROCmsg(15,""):PROCmsg(80,C$):=TRUE
  416. 4290 IF (F% AND 1) AND ((C%>25 AND C%<29) OR C%=35 OR C%=36) THEN PROCmsg(5,""):PROCmsg(80,C$):=TRUE
  417. 4300 IF (F% AND 2) AND C%=24 THEN PROCmsg(6,""):=TRUE
  418. 4310 IF (F% AND 1) AND C%=25 THEN PROCmsg(7,""):=TRUE
  419. 4320 IF (NOT F% AND 2) AND C%=9 THEN PROCmsg(8,""):=TRUE
  420. 4330 IF (NOT F% AND 1) AND C%=10 THEN PROCmsg(9,""):=TRUE
  421. 4340 IF C%=25 AND D%=COMS THEN PROCmsg(19,""):=TRUE
  422. 4350 =FALSE
  423. 4360 
  424. 4370 DEFFNvalid
  425. 4380 IF G%>128 AND C%=25 THEN PROCmsg(10,""):=TRUE
  426. 4390 IF G%=0 AND C%>25 AND C%<29 THEN PROCmsg(140,P$):=TRUE
  427. 4400 IF G%<>0 AND G%<128 AND C%>24 AND C%<29 THEN PROCmsg(80,P$):PROCmsg(11,""):=TRUE
  428. 4410 =FALSE
  429. 4420 
  430. 4430 DEFPROCmsg(n%,c$)
  431. 4440 LOCALm%,l%,t$
  432. 4450 m%=n% AND 63:l%=0:RESTORE:REPEAT:l%=l%+1:READ t$:UNTIL l%=m%
  433. 4460 IF n% AND 128 THEN t$=c$+" "+t$
  434. 4470 IF n% AND 64 THEN t$=t$+" "+c$
  435. 4480 PRINT'"* ";t$;
  436. 4490 VDU 7
  437. 4500 ENDPROC
  438. 4510 
  439. 4520 DATA don't know,value please,name please,repeating,defining,already repeating,already defining,not repeating,not defining
  440. 4530 DATA already defined,system command,not defined,I can't delete,I've forgotten,editing,can't use,required by,that command sorry,my chips are full
  441. 4540 DATA sorry I can't,evaluate,that colour no.,is not available,UNDO in EDIT mode
  442. 4550 
  443. 4560 DEFPROCload
  444. 4570 LOCALq%,d%,a$
  445. 4580 CLS:PRINTTAB(0,2)
  446. 4590 OSCLI "CAT"
  447. 4600 INPUT"Enter file name :  "a$
  448. 4605 IF a$ = "" OR LEN(a$)>10 THEN GOTO 4590
  449. 4610 quit=FALSE:D%+=1:st%=D%
  450. 4620 q%=OPENUP(a$)
  451. 4630 IF q%=0 THEN PRINT"File not found!":GOTO 5190
  452. 4640 WHILE (NOT EOF#q%) AND (NOT quit)
  453. 4650 g$=GET$#q%
  454. 4660 IF g$="" THEN 5010
  455. 4670 IF LEFT$(g$,1)=" " THEN g$=MID$(g$,2):GOTO 4660
  456. 4680 D$(D%,0)=g$
  457. 4690 WHILE LEFT$(g$,11)<>"END" AND g$<>"EN"
  458. 4700 g$=GET$#q%
  459. 4710 IF g$="" THEN 4990
  460. 4720 IF RIGHT$(g$,1)=" " THEN g$=LEFT$(g$,LEN(g$)-1):GOTO 4720
  461. 4730 IF LEFT$(g$,1)=" " THEN g$=MID$(g$,2):GOTO 4730
  462. 4740 IF g$="" THEN 4990
  463. 4750 p%=INSTR(g$,"  "):IF p%<>0 THEN g$=LEFT$(g$,p%)+MID$(g$,p%+2):GOTO 4750
  464. 4760 p%=0:REPEAT:p%+=1:UNTIL MID$(g$,p%,1)=" " OR p%=LEN(g$)
  465. 4770 IF p%<LEN(g$) THEN com$=LEFT$(g$,p%-1):param$=MID$(g$,p%+1) ELSE com$=g$:param$=""
  466. 4780 IF INSTR("CURSORENDPENHOME",com$) THEN
  467. 4790 IF INSTR("CURSOR",com$) THEN
  468. 4800 p%=INSTR(g$," ",8)
  469. 4810 com$=LEFT$(g$,p%-1):param$=MID$(g$,p%+1)
  470. 4820 ELSE
  471. 4830 com$=g$:param$=""
  472. 4840 ENDIF
  473. 4850 ENDIF
  474. 4860 p%=0:REPEAT:p%+=1:UNTIL com$=COM$(p%) OR p%=37
  475. 4870 IF p%=37 THEN
  476. 4880 IF LEN(com$)=2 THEN
  477. 4890 p%=-1:REPEAT:p%+=2:UNTIL MID$(COM$,p%,2)=com$ OR p%=73
  478. 4900 IF p%=73 THEN D$(D%,1)=D$(D%,1)+"#"+com$+"#" ELSE D$(D%,1)=D$(D%,1)+CHR$((p% DIV 2)+1)
  479. 4910 ELSE
  480. 4920 D$(D%,1)=D$(D%,1)+"#"+com$+"#"
  481. 4930 ENDIF
  482. 4940 ELSE
  483. 4950 D$(D%,1)=D$(D%,1)+CHR$(p%)
  484. 4960 ENDIF
  485. 4970 IF param$<>"" THEN D$(D%,1)=D$(D%,1)+param$
  486. 4980 D$(D%,1)=D$(D%,1)+CHR$(10)
  487. 4990 ENDWHILE
  488. 5000 D%+=1:IF D%>COMS THEN PRINT'"* sorry, no room"''"LOADING ABANDONED"':VDU7:CLOSE#q%:quit=TRUE
  489. 5010 ENDWHILE
  490. 5020 CLOSE#q%:D%-=1
  491. 5030 FOR i%=st% TO D%:p%=INSTR(D$(i%,1),"#")
  492. 5040 WHILE p%<>0
  493. 5050 p1%=INSTR(D$(i%,1),"#",p%+1):p1$=LEFT$(D$(i%,1),p%-1):p3$=MID$(D$(i%,1),p1%+1)
  494. 5060 p%+=1:p2$=MID$(D$(i%,1),p%,p1%-p%)
  495. 5070 j%=0:REPEAT:j%+=1:UNTIL p2$=D$(j%,0) OR j%>D%
  496. 5080 IF j%<=D% THEN
  497. 5090 D$(i%,1)=p1$+CHR$(j%+128)+p3$
  498. 5100 ELSE
  499. 5110 PRINT"Unknown procedure <";p2$;"> in ";D$(i%,0)
  500. 5120 PRINT"Loading abandonned":VDU7:D%=st%-1:GOTO 5190
  501. 5130 ENDIF
  502. 5140 p%=INSTR(D$(i%,1),"#")
  503. 5150 ENDWHILE
  504. 5160 NEXT
  505. 5170 PRINT'"Data file is loaded"
  506. 5180 G%=INKEY(200)
  507. 5190 ENDPROC
  508. 5200 
  509. 5210 DEFPROCinit
  510. 5220 COMS=500
  511. 5230 DIM COM$(37),D$(COMS,1),W% COMS,E% COMS,R% COMS,N% COMS,Z% 2,O% 5
  512. 5240 COM$="OSCSHMPUPDEFFLUDERENCICOCRCURTLTBEFDBKNMTRSZWRRPTOEDDLDSHELILOVLPADIPRQU"
  513. 5250 RESTORE 5320:FOR J%=1 TO 36:READ COM$(J%):NEXT
  514. 5260 S%=0:T%=0:Q%=0
  515. 5270 DIM C%(4),BE(4),X(4),Y(4),TR(4),NM(4),SZ(4),P(4),F%(4),K%(4),CO(4),P$(4),fx(7),fy(7)
  516. 5280 K%=5:F%=24:L%=0:D%=0:NM=10:NUMBER=10:TR=90:TURN=90:SZ=20:SIZE=20:X=0:Y=0:BE=0:P=0:B$=STRING$(5,CHR$8):OSWORD=&FFF1:A%=&0B:X%=O% MOD 256:Y%=O% DIV 256
  517. 5290 DIM S(5),C(5):FOR J%=0 TO 5:S(J%)=SIN(RAD(9*J%)):C(J%)=COS(RAD(9*J%)):NEXT
  518. 5300 ENDPROC
  519. 5310 
  520. 5320 DATA OSCLI,CLEAR,HOME CURSOR,PEN UP,PEN DOWN,END FILL,FILL,UNDO,END REPEAT,END,CIRCLE,COLOUR,CURSOR RIGHT,CURSOR UP,RIGHT,LEFT,BEARING,FORWARD,BACKWARDS
  521. 5330 DATA NUMBER,TURN,SIZE,WRITE,REPEAT,TO,EDIT,DELETE,DESCRIBE,HELP,LIST,LOAD,VALUES,PALETTE,DISPLAY,PRINT,QUIT
  522. 5340 
  523. 5350 DEFPROCmode
  524. 5360 SW%=79:XL%=4:CM$="{} ":DF$=" ..":RP$=" ....":t%=2:V%=15:VDU 22,12
  525. 5365 COLOUR 8,200,200,200:COLOUR 9,128,128,128:COLOUR 10,64,64,64:COLOUR 11,255,187,0:COLOUR 12,238,238,187:COLOUR13,85,136,0:COLOUR14,170,0,171:COLOUR15,181,98,57
  526. 5370 CO=1:PROCwindows
  527. 5380 ENDPROC
  528. 5390 
  529. 5400 DEFPROCwindows
  530. 5410 VDU 28,0,31,SW%,26,24,0;220;1279;1023;29,642;610;
  531. 5420 GCOL BG:GCOL 4
  532. 5430 C%=2:PROCsysex
  533. 5440 ENDPROC
  534. 5450 
  535. 5460 IF ERR=26 AND ERL=4140 THEN PROCmsg(20,""):PROCmsg(85,P$):GOTO 5490
  536. 5465 IF ERL=392 THEN 320
  537. 5470 IF ERR=17 THEN 5490
  538. 5480 VDU 22,7:REPORT:PRINT" at line ";ERL:END
  539. 5490 IF F% AND 64 THEN VDU28,0,31,SW%,26:PRINT'"EDIT ABANDONED"':F%=F% AND 188:GOTO 5520
  540. 5500 IF F% AND 1 THEN PRINT'"DEFINING ABANDONED"':F%=F% AND 252:D%=D%-1:GOTO 5520
  541. 5510 IF F% AND 2 THEN PRINT'"REPEATING ABANDONED"':F%=F% AND 253
  542. 5520 L%=0:VDU 29,642;610;:MOVE X,Y:GOTO 320
  543. 5530 
  544. 5540 DEFPROCdump
  545. 5550 *DVDUMP
  546. 5560 ENDPROC
  547.